home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / apollot.lha / apollot_sr10 / m68fix.t < prev    next >
Text File  |  1989-03-17  |  1KB  |  37 lines
  1. (herald m68fix )
  2.  
  3. (define (generate-set node location value)
  4.   (let ((access (if (lambda-node? value)        
  5.             (cond ((access/make-closure node value))
  6.               (else AN))
  7.             (access-with-rep node (leaf-value value) 'rep/pointer))))
  8.     (protect-access access)
  9.     (let ((loc (lookup node (get-lvalue (leaf-value location)) nil))
  10.       (hack1 (cons nil nil))
  11.       (hack2 (cons nil nil)))
  12.       (let ((reg (get-register 'pointer node '*)))
  13.     (release-access access)
  14.     (generate-move loc reg)
  15.     (lock reg)            ;this was a bug! check out generate-
  16.     (generate-move access (reg-offset reg 2)) ;move-address
  17.     (unlock reg)
  18.     (emit m68/tst .b (reg-offset reg 0))
  19.     (emit-jump 'jneq hack1 hack2)
  20.     (emit-tag hack1)                       
  21.     (emit m68/move .l reg (reg-offset TASK task/extra-pointer))
  22.     (generate-slink-jump slink/set)
  23.     (generate-jump hack2)
  24.     (emit-tag hack2)))))
  25.  
  26. (define (generate-move-address from to)
  27.   (cond ((register? to)
  28.          (if (or (atom? from)
  29.                  (neq? (car from) to)
  30.                  (neq? (cdr from) 0))
  31.              (emit m68/lea from to)))
  32.         ((reg-node AN)
  33.          (emit m68/pea from)
  34.          (generate-pop to))
  35.         (else
  36.          (emit m68/lea from AN)
  37.          (emit m68/move .l AN to))))